Pensieve header: The free-Lie meta-crossed-product structure, lazy evaluation version.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2012-07"];
<< "../Projects/FreeLie/FreeLieLE.m"

Randomλ[d_,m_,n_] := Module[{bas},
bas=AllLyndonWords[{d}, Characters[StringTake["1234567890", m]]];
λ[
MakeCWSeries[RandomInteger[{-2,2},Length[bas]].bas /. LW->CW],
Sum[h[j]MakeLieSeries[RandomInteger[{-2,2},Length[bas]].bas], {j,n}]
]
];
hL[λ_] := Union[Cases[λ, h[s_] :> s, Infinity]];
λ[ω_,μ_][d_] := λ[ω[d], μ /. s_LieSeries :> s[d]];
λ[ω1_, μ1_] ≡ λ[ω2_, μ2_] := ω1≡ω2 && (And @@ ((D[μ1, h[#]]≡D[μ2, h[#]])& /@ hL[{μ1, μ2}]));
LieDerivation[der_][λ[ω_, μ_]] := λ[ω//der, Collect[μ, _h, der]];
LieMorphism[mor_][λ[ω_, μ_]] := λ[ω//mor, Collect[μ, _h, mor]];

{Randomλ[1,3,3], Randomλ[3,3,3]}

tm[x_,y_,z_][λ[ω_, μ_]] := λ[ω, μ] //  LieMorphism[{⟨x⟩->⟨z⟩, ⟨y⟩->⟨z⟩}];
hm[x_,y_,z_][λ[ω_, μ_]] := λ[ω, Plus[
μ /. {h[x]->0, h[y]->0},
h[z]BCH[D[μ, h[x]], D[μ, h[y]]]
]];
hta[x_,y_,z_][λ[ω_, μ_]] := λ[0,
Collect[μ, _h,
StableApply[LieMorphism[{LW[y] -> Ad[ScaleLieSeries[-1,D[μ, h[x]]]][LW[z]]}], #]&
]
];
hta[x_,y_][λ[ω_, μ_]] := Module[{mor, ω0, μ0},
{ω0, μ0} = List @@ hta[x,y,LW["z"]][λ[ω, μ]];
mor=LieMorphism[{LW["z"] -> LW[y]}];
λ[ω0,Collect[μ0, _h, mor]]
];
dm[x_,y_,z_][λ_] := λ // hta[y,x] // tm[x,y,z] // hm[x,y,z];
Rp[x_,y_] := λ[0,h[y]MakeLieSeries[⟨x⟩]];

Testing tm

n=$SeriesShowDegree=$SeriesCompareDegree = 3;
Print /@ {λ0=Randomλ[n, 4,1],
λ0 // tm[1,2,2],
λ0 // tm[2,3,3],
t1 = λ0 // tm[1,2,2] // tm[2,3,3],
t2 = λ0 // tm[2,3,3] // tm[1,3,3],
t1≡t2
};

t1 = λ0 // tm[1,2,2] // tm[2,3,3] // InputForm

Testing hm

Print /@ {λ0=Randomλ[4, 2,3],
λ0 // hm[1,2,2],
t1 = λ0 // hm[1,2,2] // hm[2,3,3],
t2 = λ0 // hm[2,3,3] // hm[1,3,3],
t1≡t2
};

Testing hta

n=$SeriesShowDegree=$SeriesCompareDegree = 4;
Print /@ {λ0=Randomλ[3,2,2], λ0 // hta[1,1]};

Print /@ {λ0=Randomλ[n,3,2],
t1= λ0 // hta[1,1] // hta[1,2] // tm[1,2,1],
t2= λ0 // tm[1,2,1] // hta[1,1],
t1≡t2
};

n=$SeriesShowDegree=$SeriesCompareDegree = 4;
Print /@ {λ0=Randomλ[n,2,3],
t1= λ0 // hta[1,1] // hta[2,1] // hm[1,2,1],
t2= λ0 // hm[1,2,1] // hta[1,1],
t1≡t2
};

Testing dm

$SeriesShowDegree=3;
$SeriesCompareDegree = n=6;
Timing[Print /@ {λ0=Randomλ[n,4,4],
t1 = λ0 // dm[1,2,1] // dm[1,3,1],
t2 = λ0 // dm[2,3,2] // dm[1,2,1],
t1≡t2
};]

λ1=λ0 /. h[1]s_LieSeries :> h[1]ScaleLieSeries[t, s]

t1=λ1 // hta[1,1]

Clear[t2,t3];
t2[d_] := t1 /. s_LieSeries :> D[s[d], t];
μx=D[t1[[2]], h[1]];
der=LieDerivation[{LW[1] -> b[ScaleLieSeries[1/t,μx], LW[1]]}];
t3 = λ[
t1[[1]] // der,
(t1[[2]] /. {h[1]->0, s_LieSeries :> der[s]})+h[1](ScaleLieSeries[1/t,μx]+(μx//der))
];
{μx, t2[1], t3[1]}

n=2; Print /@ {t2[n], t3[n], t2[n]==t3[n]};

n=3; t2[n]==t3[n]

Table[t2[n]==t3[n], {n, 6}]